home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / qwik5x.zip / QBENCH.PAS < prev    next >
Pascal/Delphi Source File  |  1988-12-19  |  7KB  |  253 lines
  1. { =========================================================================== }
  2. { Qbench.pas - produces a 'Screens/second' table for        ver 5.x, 12-20-88 }
  3. {              QWIK Screen utilities.                                         }
  4. { This will just give you a good feel for speed.  The time is adjusted for    }
  5. { an average 8 second test for each condition - total of 56 seconds.  For     }
  6. { more accurate results, change TestTime:=16.  Or for a quicker but less      }
  7. { accurate test, change TestTime:=2.                                          }
  8. { =========================================================================== }
  9.  
  10. uses CRT,Qwik;
  11.  
  12. {$i timerd12.inc}
  13.  
  14. type
  15.   Attrs = (Attr,NoAttr);
  16.   Procs = (Qwrites,Qfills,Qattrs,Qstores,Qscrolls);
  17.  
  18. const
  19.   TestTime = 8;  { TestTime in seconds for each case.  8 gives +/- 1% }
  20.  
  21. var
  22.   Attrib, Count, Screens: integer;
  23.   Row, Col, Rows, Cols: byte;
  24.   ScrPerSec: array[Qwrites..Qscrolls] of array[Attr..NoAttr] of real;
  25.   Strng:     string[80];
  26.   Proc:      Procs;
  27.   A:         Attrs;
  28.   Names:     array[Qwrites..Qscrolls] of string[80];
  29.   FV:        text;
  30.   ToDisk:    boolean;
  31.   Ch:        char;
  32.  
  33. { Since Zenith doesn't have snow on any CGAs, turn off snow checking }
  34. procedure CheckZenith;
  35. var  ZdsRom: array[1..8] of char absolute $F000:$800C;
  36. begin
  37.   if Qsnow and (ZdsRom='ZDS CORP') then
  38.     begin
  39.       Qsnow    := false;
  40.       CardSnow := false;
  41.     end;
  42. end;
  43.  
  44. procedure ClearScr;
  45. begin
  46.   Qfill  (1,1,CRTrows,CRTcols,Yellow+BlackBG,' ');
  47. end;
  48.  
  49. procedure CheckTime;
  50. begin
  51.   Strng:='TimerTest ';
  52.   for Col:=1 to 3 do Strng:=Strng+Strng;
  53.   ClearScr;
  54.   timer (start);
  55.   for Count:=1 to Screens do
  56.     for row:=1 to 25 do
  57.       Qwrite (Row,1,Yellow,Strng);
  58.   timer (Stop);
  59.   Screens:=trunc(Screens*TestTime/ElapsedTime);
  60. end;
  61.  
  62. procedure AssembleStrng (Proc: Procs; Attrib: integer);
  63. begin
  64.   Strng:=Names[Proc];
  65.   if Qsnow then
  66.        Strng:=Strng+' Wait    '
  67.   else Strng:=Strng+' No Wait ';
  68.   if Attrib=SameAttr then
  69.        Strng:=Strng+' No Attr  '
  70.   else Strng:=Strng+' w/ Attr  ';
  71.   fillchar (Strng[32],49,byte(Proc)+49);
  72.   Strng[0]:=#80;
  73. end;
  74.  
  75. procedure TimeWriting (Proc: Procs; Attrib: integer);
  76. var  A: Attrs;
  77. begin
  78.   if Attrib=SameAttr then
  79.     begin
  80.       Qattr (1,1,CRTrows,CRTcols,LightGray);
  81.       A:=NoAttr;
  82.     end
  83.   else A:=Attr;
  84.   AssembleStrng (Proc,Attrib);
  85.   case Proc of
  86.     Qwrites:
  87.        begin
  88.          timer (start);
  89.          for Count:=1 to Screens do
  90.            for Row:=1 to 25 do
  91.              Qwrite (Row,1,Attrib,Strng);
  92.          timer (Stop);
  93.        end;
  94.     Qfills:
  95.        begin
  96.          timer (start);
  97.          for Count:=1 to Screens do
  98.            Qfill (1,1,25,80,Attrib,'f');
  99.          timer (Stop);
  100.        end;
  101.     Qattrs:
  102.        begin
  103.          Qfill (1,1,25,80,Attrib,'a');
  104.          timer (start);
  105.          for Count:=1 to Screens do
  106.            Qattr (1,1,25,80,Attrib);
  107.          timer (Stop);
  108.        end;
  109.     end;  { Case Proc of }
  110.   if ElapsedTime<>0.0 then
  111.     ScrPerSec[Proc,A]:=Screens/ElapsedTime;
  112. end;
  113.  
  114. procedure TimeMoving (Proc: Procs; Attrib: integer);
  115. var  ScrArray:  array[1..4000] of byte;
  116. begin
  117.   AssembleStrng (Proc,Attrib);
  118.   for Row:=1 to 25 do
  119.     Qwrite (Row,1,Attrib,Strng);
  120.   case Proc of
  121.     Qstores:
  122.        begin
  123.          timer (start);
  124.          for Count:=1 to Screens do
  125.            QstoreToMem (1,1,25,80,ScrArray);
  126.          timer (Stop);
  127.        end;
  128.     Qscrolls:
  129.        begin
  130.          timer (start);
  131.          for Count:=1 to Screens do
  132.            QscrollUp (1,1,25,80,SameAttr);
  133.          timer (Stop);
  134.        end;
  135.   end;  { Case Proc of }
  136.   ScrPerSec[Proc,Attr]:=Screens/ElapsedTime;
  137. end;
  138.  
  139. begin
  140.   CheckZenith;
  141.   TextAttr:=Yellow;
  142.   ClearScr;
  143.   if Qsnow then
  144.     begin
  145.       Qsnow:=false;
  146.       repeat
  147.         repeat
  148.           QwriteC (12,1,80,-1,'Do you see snow? [Y/N]?');
  149.           GotoEos;
  150.         until Keypressed;
  151.         Ch:=ReadKey;
  152.       until Ch in ['Y','y','N','n'];
  153.       case upcase(Ch) of
  154.         'Y': Qsnow:=true;
  155.         'N': begin
  156.                QwriteC (10,1,80,-1,'Congratulations!  You have a card better');
  157.                QwriteC (11,1,80,-1,'than the standard IBM CGA.');
  158.                QwriteC (12,1,80,-1,'However, to make it faster, you will need');
  159.                QwriteC (13,1,80,-1,'to set Qsnow:=false manually.');
  160.                QwriteC (14,1,80,-1,'Please contact us about this.');
  161.                QwriteC (16,1,80,-1,'Press any key ...');
  162.                GotoRC  (16,49);
  163.                Ch:=ReadKey;
  164.                if Ch=#00 then Ch:=ReadKey;
  165.              end;
  166.       end;
  167.     end;
  168.   ClearScr;
  169.   QwriteC (12,1,CRTcols,-1,'Data to Screen or Disk [s/d]? ');
  170.   GotoEos;
  171.   repeat
  172.     Ch:=ReadKey;
  173.   until Ch in ['S','s','D','d',^M];
  174.   if upcase(Ch)='D' then
  175.        ToDisk:=true
  176.   else ToDisk:=false;
  177.   ModCursor (CursorOff);
  178.  
  179.   for Proc:=Qwrites to Qscrolls do
  180.     for A:=Attr to NoAttr do
  181.       ScrPerSec[Proc,A]:=0.0;
  182.  
  183.   Names[Qwrites ]:= ' Qwrite-     ';
  184.   Names[Qfills  ]:= ' Qfill-      ';
  185.   Names[Qattrs  ]:= ' Qattr-      ';
  186.   Names[Qstores ]:= ' Qstore-     ';
  187.   Names[Qscrolls]:= ' Qscroll-    ';
  188.  
  189.   if Qsnow then
  190.        Screens:=8    { First guess for screens }
  191.   else Screens:=80;  { First guess for screens }
  192.   CheckTime;
  193.   TimeWriting (Qwrites ,Yellow);
  194.   TimeWriting (Qwrites ,SameAttr);
  195.   TimeWriting (Qfills  ,Yellow);
  196.   TimeWriting (Qfills  ,SameAttr);
  197.   TimeWriting (Qattrs  ,Yellow);
  198.   TimeMoving  (Qstores ,Yellow);
  199.   TimeMoving  (Qscrolls,Yellow);
  200.  
  201.   ClearScr;
  202.   if ToDisk then
  203.        assign    (FV,'Qbench.dta')
  204.   else assignCRT (FV);
  205.   rewrite (FV);
  206.   GotoRC (1,1);
  207.   writeln (FV,'S C R E E N S / S E C O N D');
  208.   writeln (FV,'             Chng');
  209.   writeln (FV,'Procedure    Attr S/sec  Typical for these procedures:');
  210.   write   (FV,'---------    ---- -----  -----------------------------');
  211.   writeln (FV,'------------------');
  212.   for Proc:=Qwrites to Qfills do
  213.   for A:=Attr to NoAttr do
  214.     begin
  215.       if A=Attr then
  216.            write (FV,Names[Proc])
  217.       else write (FV,'             ');
  218.       if A=Attr then
  219.            write (FV,'Yes  ')
  220.       else write (FV,'No   ');
  221.       write (FV,ScrPerSec[Proc,A]:5:1,'  ');
  222.       if A=Attr then
  223.         case Proc of
  224.           Qwrites:
  225.             writeln (FV,'Qwrite, QwriteC, QwriteA, QwriteEos, QwriteEosA');
  226.           Qfills:  writeln (FV,'Qfill, QfillC, QfillEos');
  227.         end
  228.       else writeln (FV);
  229.     end;
  230.   for Proc:=Qattrs to Qscrolls do
  231.     begin
  232.       write (FV,Names[Proc]);
  233.       if Proc=Qattrs then
  234.            write (FV,'Yes  ')
  235.       else write (FV,'n/a  ');
  236.       write (FV,ScrPerSec[Proc,Attr]:5:1,'  ');
  237.       case Proc of
  238.         Qattrs:  writeln (FV,'Qattr, QattrEos');
  239.         Qstores:
  240.           writeln (FV,'QstoreToMem, QstoreToScr, QscrToVscr, QVscrToScr');
  241.         Qscrolls:writeln (FV,'QscrollUp, QscrollDown');
  242.       end
  243.     end;
  244.   GotoRC  (13,1);
  245.   writeln (FV,'SystemID         = ',SystemID);
  246.   writeln (FV,'CPU ID           = ',CpuID);
  247.   writeln (FV,'Wait-for-retrace = ',Qsnow);
  248.   writeln (FV,'Screens/test     = ',Screens);
  249.   close   (FV);
  250.   GotoRC  (24,1);
  251.   SetCursor (CursorInitial);
  252. end.
  253.